home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / kdpasfos.zip / KDFOSSIL.PAS
Pascal/Delphi Source File  |  1988-12-03  |  9KB  |  318 lines
  1. { Unit written by Kelly Drown for interfacing the Fossil Driver. This is a   }
  2. { a beta test unit and as such, is not fully tested, nor is it garunteed to  }
  3. { to work. You are free to use this code as you wish and modify as you see   }
  4. { fit. I would, however, like you to mention my name in your documentation   }
  5. { if you use this code. I ask this courtesy in place of asking for funds, as }
  6. { this code is covered under my standard copyright. Thanks.                  }
  7.  
  8. {  Beta test version 0.03 }
  9.  
  10. UNIT KDFOSSIL;
  11.  
  12. INTERFACE
  13.  
  14. Uses Dos;
  15.  
  16. Var
  17.    Regs       : Registers;
  18.    Port       : Integer;
  19.    Result     : Boolean;
  20.    Esc        : Char;
  21.    Num,
  22.    NumB       : String;
  23.  
  24. {---------------------------- User Routines ------------------------------}
  25.  
  26. Function CheckCarrier( Port : Integer ) : Boolean;
  27. Procedure Modem_Send( ch : Char; Port : Integer );
  28. Procedure Modem_Send_String( Str : String; Port : Integer );
  29. Procedure DeInitFossil( Port : Integer );
  30. Procedure InitFossil( Port, Baud : Integer );
  31. Procedure Modem_Input( VAR Inchar : Byte; Port : Integer );
  32. Procedure CursorForward( Row, Port : Integer );
  33. Procedure CursorBackward( Row, Port : Integer );
  34. Procedure CursorUp( Row, Port : Integer );
  35. Procedure CursorDown( Row, Port : Integer );
  36. Procedure CursorPos( Row, RowB, Port : Integer );
  37. Procedure ClearScreen( Port : Integer );
  38. Procedure ClearEOL( Port : Integer );
  39. Procedure Modem_Send_Blink( Str : String; Port : Integer );
  40. Procedure CursorColor( Row, RowB, Port : Integer );
  41. Procedure WarmBoot;
  42. Procedure ColdBoot;
  43. Procedure ControlDTR( Port, State : Integer );
  44. Procedure FlushOutput( Port : Integer );
  45. Procedure PurgeOutput( Port : Integer );
  46. Procedure PurgeInput( Port : Integer );
  47. Function Local( VAR Scan : Byte ) : Boolean;
  48.  
  49.  
  50. IMPLEMENTATION
  51.  
  52. {-------------------------------------------------------------------------}
  53. Function CheckCarrier( Port : Integer ) : Boolean;
  54.  
  55. Var TestBit : Byte;
  56.  
  57. Begin
  58.      TestBit := 7;             { Carrier Detect Bit }
  59.        With Regs do
  60.        Begin
  61.          Ah := $03;            { Address for DCD Checking         }
  62.          Dx := Port -1;           { Tell Fossil what Port to check   }
  63.        End;
  64.          Intr($14,Regs);       { Pass registers through Int 14h   }
  65.      Result := ( Regs.Al AND ( 1 SHL TestBit ) ) = 0; { Check Bit 7 True }
  66.         IF Result = True THEN Begin
  67.           WriteLn( #7, 'CARRIER NOT PRESENT OR LOST!' );
  68.           With Regs Do
  69.             Begin
  70.               ah := $05;
  71.               dx := Port -1;      { De-Initialize port from app.     }
  72.             End;
  73.           Intr($14,Regs);
  74.           CheckCarrier := False; { NO CARRIER! }
  75.           Exit;
  76.           End;
  77.      CheckCarrier := True;
  78.  End;
  79. {-------------------------------------------------------------------------}
  80. Procedure ControlDTR( Port, State : Integer );
  81. Begin
  82.   With Regs DO
  83.    Begin
  84.     ah := $06;
  85.     dx := Port -1;
  86.     Case State OF
  87.       0 : al := $00;
  88.       1 : al := $01;
  89.     End;
  90.    End;
  91.   Intr($14,Regs);
  92. End;
  93. {-------------------------------------------------------------------------}
  94. Procedure FlushOutput( Port : Integer );
  95. Begin
  96.   With Regs DO
  97.     Begin
  98.     ah := $08;
  99.     dx := Port -1;
  100.     End;
  101.   Intr($14,Regs);
  102. End;
  103. {-------------------------------------------------------------------------}
  104. Procedure PurgeOutput( Port : Integer );
  105. Begin
  106.   With Regs DO
  107.     Begin
  108.     ah := $09;
  109.     dx := Port -1;
  110.     End;
  111.   Intr($14,Regs);
  112. End;
  113. {-------------------------------------------------------------------------}
  114. Procedure PurgeInput( Port : Integer );
  115. Begin
  116.   With Regs DO
  117.     Begin
  118.     ah := $0a;
  119.     dx := Port -1;
  120.     End;
  121.   Intr($14,Regs);
  122. End;
  123. {-------------------------------------------------------------------------}
  124. Function Local( VAR Scan : Byte ) : Boolean;
  125. Begin
  126.   Regs.ah := $0d;
  127.   Intr($14,Regs);
  128.  IF Regs.ax = $FFFF THEN Local := False
  129.  ELSE Begin
  130.         Scan := Regs.ax;
  131.         Local := True;
  132.       End;
  133. End;
  134. {-------------------------------------------------------------------------}
  135. Procedure WarmBoot;
  136. Begin
  137.   With Regs DO
  138.     Begin
  139.     ah := $17;
  140.     al := $01;
  141.     End;
  142.   Intr($14,Regs);
  143. End;
  144. {-------------------------------------------------------------------------}
  145. Procedure ColdBoot;
  146. Begin
  147.   With Regs DO
  148.     Begin
  149.     ah := $17;
  150.     al := $00;
  151.     End;
  152.   Intr($14,Regs);
  153. End;
  154. {-------------------------------------------------------------------------}
  155. Procedure Modem_Send(ch : char; Port : Integer);
  156.  
  157. Begin
  158.   Write(ch);
  159.      With regs do
  160.        Begin
  161.           Ah := $01;
  162.           Dx := Port -1;
  163.           Al := Ord(ch);
  164.        End;
  165.       Intr($14,regs);
  166. End;
  167. {-------------------------------------------------------------------------}
  168. Procedure Modem_Send_String( Str : String; Port : Integer );
  169. Var i : Integer;
  170. Begin
  171.      For i := 1 to Length(Str) Do
  172.      Modem_Send(Str[i], Port);
  173. End;
  174. {-------------------------------------------------------------------------}
  175. Procedure DeInitFossil( Port : Integer );
  176.  
  177. Begin
  178.   With Regs Do
  179.     Begin
  180.       ah := $08;
  181.       dx := Port -1;
  182.     End;
  183.     Intr($14,regs);  {Flush any pending output on out the door}
  184.  
  185.   With Regs do
  186.     Begin
  187.       Ah := $05;
  188.       Dx := Port -1;
  189.     End;
  190.       Intr($14,Regs);    { De-Initialize Fossil Driver }
  191.    halt;
  192. End;
  193. {-------------------------------------------------------------------------}
  194. Procedure InitFossil( Port, Baud : Integer );
  195.  
  196. Begin
  197.        With Regs do
  198.           Begin
  199.            ah := $04;
  200.            dx := Port -1;
  201.           End;
  202.            Intr($14,Regs);
  203.  
  204.          With Regs do
  205.           Begin
  206.            ah := $00;
  207.            dx := Port -1;
  208.          CASE Baud of
  209.                300 : al := 67;
  210.               1200 : al := 131;
  211.               2400 : al := 163;
  212.               4800 : al := 195;
  213.               9600 : al := 227;
  214.          End;  { Case }
  215.        End;  { Registers }
  216.      Intr($14,Regs);
  217.   End;
  218. {-----------------------------------------------------------------------}
  219.  
  220. Procedure Modem_Input( VAR Inchar : Byte;
  221.                            port   : Integer );
  222.  
  223. Begin
  224.     With Regs DO
  225.     Begin
  226.       ah := $0a;  {purge input buffer}
  227.       dx := Port -1;
  228.     END;
  229.     Intr($14,Regs);
  230.  Repeat
  231.     With Regs Do
  232.        Begin
  233.           ah := $0c;
  234.           dx := Port -1;
  235.        End;
  236.     Intr($14,Regs);
  237. Until Regs.AX <> $FFFF;
  238.     Inchar := Regs.al;
  239. End;
  240. {-------------------------------------------------------------------------}
  241. Procedure CursorForward( Row : Integer; Port : Integer );
  242. Begin
  243.      Esc := Chr(27);
  244.      Str( Row, Num );
  245.      Modem_Send_String( Esc+ '['+ Num+ 'c', Port );
  246.      Write( Esc + '[' + Num + 'c' );
  247. End;
  248. {-------------------------------------------------------------------------}
  249. Procedure CursorBackward( Row : Integer; Port : Integer );
  250. Begin
  251.      Esc := Chr(27);
  252.      Str( Row, Num );
  253.      Modem_Send_String( Esc+ '[' + Num+ 'd', Port );
  254.      Write( Esc + '[' + Num + 'd' );
  255. End;
  256. {-------------------------------------------------------------------------}
  257. Procedure CursorUp( Row : Integer; Port : Integer );
  258. Begin
  259.      Esc := Chr(27);
  260.      Str( Row, Num );
  261.      Modem_Send_String( Esc+ '[' + Num+ 'a', Port );
  262.      Write( Esc + '[' + Num + 'a' );
  263. End;
  264. {-------------------------------------------------------------------------}
  265. Procedure CursorDown( Row : Integer; Port : Integer );
  266. Begin
  267.      Esc := Chr(27);
  268.      Str( Row, Num );
  269.      Modem_Send_String( Esc+ '[' + Num+ 'b', Port );
  270.      Write( Esc + '[' + Num + 'b' );
  271. End;
  272. {-------------------------------------------------------------------------}
  273. Procedure CursorPos( Row, RowB, Port : Integer );
  274. Begin
  275.      Esc := Chr(27);
  276.      Str( Row, Num );
  277.      Str( RowB, NumB );
  278.      Modem_Send_String( Esc+ '['+ Num+ ';'+ NumB+ 'h', Port );
  279.      Write( Esc+ '['+ Num+ ';'+ NumB+ 'h' );
  280. End;
  281. {-------------------------------------------------------------------------}
  282. Procedure ClearScreen( Port : Integer );
  283. Begin
  284.      Esc := Chr(27);
  285.      Modem_Send_String( Esc+ '[2j', Port );
  286.      Write( Esc+ '[2j' );
  287. End;
  288. {-------------------------------------------------------------------------}
  289. Procedure ClearEOL( Port : Integer );
  290. Begin
  291.      Esc := Chr(27);
  292.      Modem_Send_String( Esc+ '[k', Port );
  293.      Write( Esc+ '[k' );
  294. End;
  295. {-------------------------------------------------------------------------}
  296. Procedure Modem_Send_Blink( Str : String; Port : Integer );
  297. Begin
  298.      Esc := Chr(27);
  299.      Modem_Send_String( Esc+ '[5m'+ Str+ '[m', Port );
  300.      Write( Esc+ '[5m', Str, '[m' );
  301. End;
  302. {-------------------------------------------------------------------------}
  303. Procedure CursorColor( Row, RowB, Port : Integer );
  304.  
  305.    { Row and RowB are Foreground and Background respectively }
  306.  
  307. Begin
  308.      Esc := Chr(27);
  309.      Str( Row, Num );
  310.      Str( RowB, NumB );
  311.      Modem_Send_String( Esc+ '['+ Num+ ';'+ NumB+ 'm', Port );
  312.      Write( Esc+ '['+ Num+ ';'+ NumB+ 'm' );
  313. End;
  314. {-------------------------------------------------------------------------}
  315.  
  316.  
  317. end. { The End }
  318.